home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d3456 / gmprintsuite_eval.exe / {app} / GmRtfPreview.pas < prev    next >
Pascal/Delphi Source File  |  2002-01-09  |  14KB  |  454 lines
  1. {******************************************************************************}
  2. {                                                                              }
  3. {                            TGmRtfPreview 2.3                                 }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.com                 }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.com                                }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmRtfPreview;
  14.  
  15. interface
  16.  
  17. { To add RxRichEdit functionallity to TGmRtfPreview, simply
  18.   uncomment the line below...
  19. }
  20.  
  21. // {$DEFINE RXRICHEDIT}
  22.  
  23. uses
  24.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  25.   GmPreview, ComCtrls, ClipBrd, StdCtrls
  26.   {$IFDEF RXRICHEDIT}
  27.   , RxRichEd
  28.   {$ENDIF}
  29.   ;
  30. type
  31.   TGmRtfPreview = class(TComponent)
  32.   private
  33.     FPreview: TGmPreview;
  34.     FTextFileFont: TFont;
  35.     procedure SetTextFileFont(AFont: TFont);
  36.     { Private declarations }
  37.   protected
  38.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  39.     { Protected declarations }
  40.   public
  41.     constructor Create(AOwner: TComponent); override;
  42.     destructor Destroy; override;
  43.  
  44. //    procedure Load(ACustomMemo: TCustomMemo);
  45.     procedure LoadRichText(ACustomMemo: TCustomMemo);
  46.  
  47.     //procedure LoadRtfFromFile(AFileName: string);
  48. //    procedure LoadRtfFromRichEdit(ARichEdit: TRichEdit; IsRichText: Boolean);
  49.     //procedure LoadRtfFromStream(AStream: TStream);
  50.     //procedure LoadRtfFromClipboard;
  51.     {$IFDEF RXRICHEDIT}
  52.     procedure LoadRtfFromRxFile(AFileName: string);
  53.     procedure LoadRtfFromRxRichEdit(ARichEdit: TCustomMemo; IsRichText: Boolean);
  54.     procedure LoadRtfFromRxStream(AStream: TStream);
  55.     {$ENDIF}
  56.  
  57.    // procedure LoadTextFromFile(AFileName: string);
  58.     { Public declarations }
  59.   published
  60.     property Preview: TGmPreview read FPreview write FPreview;
  61.     property TextFileFont: TFont read FTextFileFont write SetTextFileFont;
  62.     // events...
  63.     { Published declarations }
  64.   end;
  65.  
  66. //procedure Register;
  67.  
  68. implementation
  69.  
  70. uses RichEdit;
  71.  
  72. constructor TGmRtfPreview.Create(AOwner: TComponent);
  73. begin
  74.   inherited;
  75.   FTextFileFont := TFont.Create;
  76.   with FTextFileFont do
  77.   begin
  78.     Name := 'Arial';
  79.     Size := 12;
  80.   end;
  81. end;
  82.  
  83. destructor TGmRtfPreview.Destroy;
  84. begin
  85.   if Assigned(FTextFileFont) then FTextFileFont.Free;
  86.   inherited;
  87. end;
  88.  
  89. {procedure TGmRtfPreview.Load(ACustomMemo: TCustomMemo);
  90. var
  91.   IsRichText: Boolean;
  92. begin
  93.   IsRichText := (ACustomMemo is TCustomRichEdit);
  94.   if ACustomMemo.ClassName = 'TRichEdit'    then //LoadMemoText(ACustomMemo);
  95.   if ACustomMemo.ClassName = 'TRichEdit98'  then //LoadMemoText(ACustomMemo, IsRichText);
  96.   //if ACustomMemo.ClassName = 'TRxRichEdit'  then LoadRtfFromRxRichEdit(ACustomMemo, IsRichText);
  97. end;}
  98.  
  99. procedure TGmRtfPreview.Notification(AComponent: TComponent; Operation: TOperation);
  100. begin
  101.   inherited Notification(AComponent, Operation);
  102.   if (Operation = opRemove) and (AComponent = FPreview) then
  103.     FPreview := nil;
  104. end;
  105.  
  106. procedure TGmRtfPreview.SetTextFileFont(AFont: TFont);
  107. begin
  108.   FTextFileFont.Assign(AFont);
  109. end;
  110.  
  111. {procedure TGmRtfPreview.LoadTextFromFile(AFileName: string);
  112. var
  113.   AParent: TForm;
  114.   ARichEdit: TRichEdit;
  115. begin
  116.   AParent := TForm.Create(nil);
  117.   ARichEdit := TRichEdit.Create(AParent);
  118.   ARichEdit.Parent := AParent;
  119.   ARichEdit.Lines.LoadFromFile(AFileName);
  120.   Application.ProcessMessages;
  121.   ARichEdit.Font.Assign(FTextFileFont);
  122.   try
  123.     LoadRtfFromRichEdit(ARichEdit, False);
  124.   finally
  125.     ARichEdit.Free;
  126.     AParent.Free;
  127.   end;
  128. end;  }
  129.  
  130.  
  131. procedure TGmRtfPreview.LoadRichText(ACustomMemo: TCustomMemo);
  132. var
  133.   Range: TFormatRange;
  134.   LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  135.   SaveRect: TRect;
  136.   mf: TMetafile;
  137.   mfc: TMetafileCanvas;
  138. begin
  139.   if Assigned(FPreview) then with FPreview do
  140.   begin
  141.     {if not IsRichText then
  142.     begin
  143.       LastFont := TFont.Create;
  144.       LastFont.Assign(ACustomMemo.Font);
  145.       ACustomMemo.Font.Assign(FTextFileFont);
  146.     end
  147.     else
  148.       LastFont := nil;    }
  149.     Clear;
  150.     mf := TMetafile.Create;
  151.     mfc := TMetafileCanvas.Create(mf, 0);
  152.     try
  153.       FillChar(Range, SizeOf(TFormatRange), 0);
  154.       with Range do
  155.       begin
  156.         hdc := mfc.Handle;
  157.         hdcTarget := hdc;
  158.         LogX := GetDeviceCaps(mfc.Handle, LOGPIXELSX);
  159.         LogY := GetDeviceCaps(mfc.Handle, LOGPIXELSY);
  160.         rc.Top   := Round(((Margins.Top.AsInches+Header.Height.AsInches)+0.2) *96) * 1440 div LogY;
  161.         rc.Left   := Round(Margins.Left.AsInches *96) * 1440 div LogX;
  162.         rc.bottom := Round((PageHeight.AsInches - ((Margins.Bottom.AsInches+Footer.Height.AsInches)+0.2))*96) * 1440 div LogX;
  163.         rc.right := Round((pageWidth.AsInches - Margins.Right.AsInches)*96) * 1440 div LogY;
  164.         rcPage := rc;
  165.         SaveRect := rc;
  166.         LastChar := 0;
  167.         MaxLen := ACustomMemo.GetTextLen;
  168.         chrg.cpMax := -1;
  169.         // ensure printer DC is in text map mode
  170.         OldMap := SetMapMode(hdc, MM_TEXT);
  171.         SendMessage(ACustomMemo.Handle, EM_FORMATRANGE, 0, 0);    // flush buffer
  172.         try
  173.           repeat
  174.             rc := SaveRect;
  175.             chrg.cpMin := LastChar;
  176.             LastChar := SendMessage(ACustomMemo.Handle, EM_FORMATRANGE, 1, Longint(@Range));
  177.             if (LastChar < MaxLen) and (LastChar <> -1) then
  178.             begin
  179.               mfc.Free;
  180.               Canvas.Draw(0,0,mf,1,GmMillimeters);
  181.               NewPage;
  182.               mf.Clear;
  183.               mfc := TMetafileCanvas.Create(mf,0);
  184.               range.hdc := mfc.Handle;
  185.               range.hdcTarget := mfc.Handle;
  186.             end;
  187.           until (LastChar >= MaxLen) or (LastChar = -1);
  188.         finally
  189.           SendMessage(ACustomMemo.Handle, EM_FORMATRANGE, 0, 0);  // flush buffer
  190.           SetMapMode(hdc, OldMap);       // restore previous map mode
  191.         end;
  192.       end;
  193.     finally
  194.       mfc.Free;
  195.       Canvas.Draw(0,0,mf,1,GmMillimeters);
  196.       mf.Free;
  197.       {if not IsRichText then
  198.       begin
  199.         ARichEdit.Font.Assign(LastFont);
  200.         LastFont.Free;
  201.       end;}
  202.     end;
  203.     UpdatePreview;
  204.   end;
  205. end;
  206.  
  207. {procedure TGmRtfPreview.LoadRtfFromFile(AFileName: string);
  208. var
  209.   FileStream: TFileStream;
  210. begin
  211.   FileStream := TFileStream.Create(AFileName, fmOpenRead);
  212.   try
  213.     FileStream.Seek(0, soFromBeginning);
  214.     LoadRtfFromStream(FileStream);
  215.   finally
  216.     FileClose(FileStream.Handle);
  217.   end;
  218. end;}
  219.  
  220. {procedure TGmRtfPreview.LoadRtfFromStream(AStream: TStream);
  221. var
  222.   AParent: TForm;
  223.   ARichEdit: TRichEdit;
  224. begin
  225.   AParent := TForm.Create(nil);
  226.   ARichEdit := TRichEdit.Create(AParent);
  227.   ARichEdit.Parent := AParent;
  228.   ARichEdit.Lines.LoadFromStream(AStream);
  229.   try
  230.     LoadRtfFromRichEdit(ARichEdit, True);
  231.   finally
  232.     ARichEdit.Free;
  233.     AParent.Free;
  234.   end;
  235. end;  }
  236.  
  237. {procedure TGmRtfPreview.LoadRtfFromClipboard;
  238. var
  239.   AParent: TForm;
  240.   ARichEdit: TRichEdit;
  241. begin
  242.   AParent := TForm.Create(nil);
  243.   ARichEdit := TRichEdit.Create(AParent);
  244.   ARichEdit.Parent := AParent;
  245.   ARichEdit.Text := (ClipBoard.AsText);
  246.   try
  247.     LoadRtfFromRichEdit(ARichEdit, True);
  248.   finally
  249.     ARichEdit.Free;
  250.     AParent.Free;
  251.   end;
  252. end;}
  253.  
  254. {procedure TGmRtfPreview.LoadRtfFromRichEdit(ARichEdit: TRichEdit; IsRichText: Boolean);
  255. var
  256.   Range: TFormatRange;
  257.   LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  258.   SaveRect: TRect;
  259.   mf: TMetafile;
  260.   mfc: TMetafileCanvas;
  261.   LastFont: TFont;
  262.   TextLenEx: TGetTextLengthEx;
  263.   PercentDone: Extended;
  264. begin
  265.   if Assigned(FPreview) then with FPreview do
  266.   begin
  267.     if not IsRichText then
  268.     begin
  269.       LastFont := TFont.Create;
  270.       LastFont.Assign(ARichEdit.Font);
  271.       ARichEdit.Font.Assign(FTextFileFont);
  272.     end
  273.     else
  274.       LastFont := nil;
  275.     Clear;
  276.     mf := TMetafile.Create;
  277.     mfc := TMetafileCanvas.Create(mf, 0);
  278.     try
  279.       FillChar(Range, SizeOf(TFormatRange), 0);
  280.       with Range do
  281.       begin
  282.         hdc := mfc.Handle;
  283.         hdcTarget := hdc;
  284.         LogX := GetDeviceCaps(mfc.Handle, LOGPIXELSX);
  285.         LogY := GetDeviceCaps(mfc.Handle, LOGPIXELSY);
  286.         rc.Top   := Round((Margins.Top.AsInches+Header.Height.AsInches) *96) * 1440 div LogX;
  287.         rc.Left   := Round(Margins.Left.AsInches *96) * 1440 div LogX;
  288.         rc.bottom := Round((PageHeight.AsInches - ((Margins.Bottom.AsInches+Footer.Height.AsInches)+0.2))*96) * 1440 div LogX;
  289.         rc.right := Round((pageWidth.AsInches - Margins.Right.AsInches)*96) * 1440 div LogY;
  290.         rcPage := rc;
  291.         SaveRect := rc;
  292.         LastChar := 0;
  293.         MaxLen := ARichEdit.GetTextLen;
  294.         chrg.cpMax := -1;
  295.         // ensure printer DC is in text map mode
  296.         OldMap := SetMapMode(hdc, MM_TEXT);
  297.         SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 0, 0);    // flush buffer
  298.         try
  299.           PercentDone := 0;
  300.           repeat
  301.             rc := SaveRect;
  302.             chrg.cpMin := LastChar;
  303.             LastChar := SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
  304.             if (LastChar < MaxLen) and (LastChar <> -1) then
  305.             begin
  306.               mfc.Free;
  307.               Canvas.Draw(0,0,mf,1,GmMillimeters);
  308.               NewPage;
  309.               mf.Clear;
  310.               mfc := TMetafileCanvas.Create(mf,0);
  311.               range.hdc := mfc.Handle;
  312.               range.hdcTarget := mfc.Handle;
  313.             end;
  314.            // PercentDone :=
  315.           until (LastChar >= MaxLen) or (LastChar = -1);
  316.         finally
  317.           SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 0, 0);  // flush buffer
  318.           SetMapMode(hdc, OldMap);       // restore previous map mode
  319.         end;
  320.       end;
  321.     finally
  322.       mfc.Free;
  323.       Canvas.Draw(0,0,mf,1,GmMillimeters);
  324.       if not IsRichText then
  325.       begin
  326.         ARichEdit.Font.Assign(LastFont);
  327.         LastFont.Free;
  328.       end;
  329.     end;
  330.     UpdatePreview;
  331.   end;
  332. end;  }
  333.  
  334. {$IFDEF RXRICHEDIT}
  335.  
  336. procedure TGmRtfPreview.LoadRtfFromRxFile(AFileName: string);
  337. var
  338.   FileStream: TFileStream;
  339. begin
  340.   FileStream := TFileStream.Create(AFileName, fmOpenRead);
  341.   try
  342.     FileStream.Seek(0, soFromBeginning);
  343.     LoadRtfFromRxStream(FileStream);
  344.   finally
  345.     FileClose(FileStream.Handle);
  346.   end;
  347. end;
  348.  
  349. procedure TGmRtfPreview.LoadRtfFromRxRichEdit(ARichEdit: TCustomMemo; IsRichText: Boolean);
  350. var
  351.   Range: TFormatRange;
  352.   LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  353.   SaveRect: TRect;
  354.   TextLenEx: TGetTextLengthEx;
  355.   mf: TMetafile;
  356.   mfc: TMetafileCanvas;
  357.   LastFont: TFont;
  358. begin
  359.   if Assigned(FPreview) then with FPreview do
  360.   begin
  361.     {if not IsRichText then
  362.     begin
  363.       LastFont := TFont.Create;
  364.       LastFont.Assign(ARichEdit.Font);
  365.       ARichEdit.Font.Assign(FTextFileFont);
  366.     end
  367.     else
  368.       LastFont := nil;
  369.     Clear;}
  370.     mf := TMetafile.Create;
  371.     mfc := TMetafileCanvas.Create(mf, 0);
  372.     try
  373.       FillChar(Range, SizeOf(TFormatRange), 0);
  374.       with Range do
  375.       begin
  376.         hdc := mfc.Handle;
  377.         hdcTarget := hdc;
  378.         LogX := GetDeviceCaps(mfc.Handle, LOGPIXELSX);
  379.         LogY := GetDeviceCaps(mfc.Handle, LOGPIXELSY);
  380.         rc.Top   := Round((Margins.Top.AsInches+Header.Height.AsInches) *96) * 1440 div LogX;
  381.         rc.Left   := Round(Margins.Left.AsInches *96) * 1440 div LogX;
  382.         rc.bottom := Round((PageHeight.AsInches - ((Margins.Bottom.AsInches+Footer.Height.AsInches)+0.2))*96) * 1440 div LogX;
  383.         rc.right := Round((pageWidth.AsInches - Margins.Right.AsInches)*96) * 1440 div LogY;
  384.         rcPage := rc;
  385.         SaveRect := rc;
  386.         LastChar := 0;
  387.         if RichEditVersion >= 2 then
  388.         begin
  389.           with TextLenEx do begin
  390.             flags := GTL_DEFAULT;
  391.             codepage := CP_ACP;
  392.           end;
  393.           MaxLen := ARichEdit.perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);
  394.         end
  395.         else MaxLen := GetTextLen;
  396.         chrg.cpMax := -1;
  397.         { ensure printer DC is in text map mode }
  398.         OldMap := SetMapMode(hdc, MM_TEXT);
  399.         SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 0, 0);    { flush buffer }
  400.         try
  401.           repeat
  402.             rc := SaveRect;
  403.             chrg.cpMin := LastChar;
  404.             LastChar := SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
  405.             if (LastChar < MaxLen) and (LastChar <> -1) then
  406.             begin
  407.               mfc.Free;
  408.               Canvas.Draw(0,0,mf,1,GmMillimeters);
  409.               NewPage;
  410.               mf.Clear;
  411.               mfc := TMetafileCanvas.Create(mf,0);
  412.               range.hdc := mfc.Handle;
  413.               range.hdcTarget := mfc.Handle;
  414.             end;
  415.           until (LastChar >= MaxLen) or (LastChar = -1);
  416.         finally
  417.           SendMessage(ARichEdit.Handle, EM_FORMATRANGE, 0, 0);  // flush buffer
  418.           SetMapMode(hdc, OldMap);       // restore previous map mode
  419.         end;
  420.       end;
  421.     finally
  422.       mfc.Free;
  423.       Canvas.Draw(0,0,mf,1,GmMillimeters);
  424. {      if not IsRichText then
  425.       begin
  426.         ARichEdit.Font.Assign(LastFont);
  427.         LastFont.Free;
  428.       end;}
  429.     end;
  430.     UpdatePreview;
  431.   end;
  432. end;
  433.  
  434. procedure TGmRtfPreview.LoadRtfFromRxStream(AStream: TStream);
  435. var
  436.   AParent: TForm;
  437.   ARichEdit: TRxRichEdit;
  438. begin
  439.   AParent := TForm.Create(nil);
  440.   ARichEdit := TRxRichEdit.Create(AParent);
  441.   ARichEdit.Parent := AParent;
  442.   ARichEdit.Lines.LoadFromStream(AStream);
  443.   try
  444.     LoadRtfFromRxRichEdit(ARichEdit, True);
  445.   finally
  446.     ARichEdit.Free;
  447.     AParent.Free;
  448.   end;
  449. end;
  450.  
  451. {$ENDIF}
  452.  
  453. end.
  454.